//	COPYRIGHT (C) 1981 BY BOARD OF TRUSTEES,
//	LELAND STANFORD JUNIOR UNIVERSITY

STATIC $( MOLFORM = NIL; STRUCSTATUS = NIL; ALLDEFS = NIL; MODMF = NIL;
          SAPROPS = NIL; INTERNALCONS = NIL; CONLENGTHS = NIL;
          RINGCONS = NIL; MINSTRUCNO = NIL; MAXSTRUCNO = NIL;
          TERMTYPE = NIL; ARLIST = NIL; MODARLIST = NIL;
          PARTIALFLAG = NIL; STOPAFTER = NIL $);
MANIFEST $( SUBCONTYPE = 1; PROTCONTYPE = 2; RINGCONTYPE = 3;
            LOOPCONTYPE = 4; PARTCONTYPE = 5 $);
STATIC $( INPUTSAVE = NIL; OUTPUTSAVE = NIL $);

LET OPENIN(FILEFN) BE
 $(
 INPUTSAVE:=INPUT;
 SWAPLITEMS();
 INPUT:=FINDFILE("DSK",FILEFN(),CGEXT);
 $);

LET CLOSEIN() BE
 $(
 ENDREAD(INPUT);
 INPUT:=INPUTSAVE;
 SWAPLITEMS()
 $);

LET OPENOUT(FILEFN) BE
 $(
 OUTPUTSAVE:=OUTPUT;
 OUTPUT:=CREATEFILE("DSK",FILEFN(),CGEXT)
 $);

LET CLOSEOUT() BE
 $(
 ENDWRITE(OUTPUT);
 OUTPUT:=OUTPUTSAVE
 $);


LET CGINIT() BE
 $(
 INPUTSAVE:=INPUT;
 INPUT:=FINDFILE("DSK","INIT","CG0",MAKPPN);
 OPENOUT(TOPFILENAME);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 LPOSN:=0;
 WHILE FILEEXISTS(STRFILENAME(),CGEXT) DO
  DELETEFILE(STRFILENAME(),CGEXT);
 WHILE FILEEXISTS(STIFILENAME(),CGEXT) DO
  DELETEFILE(STIFILENAME(),CGEXT);
 OUTS("WELCOME TO STRCHK, VERSION I.*C*L");
 OUTS("COPYRIGHT (C) 1980 BY THE BOARD OF TRUSTEES OF THE LELAND STANFORD*C*L")
 OUTS("JUNIOR UNIVERSITY.*C*L")
OUTS("STRCHK IS A PROGRAM FOR EVALUATING CANDIDATE STRUCTURES CREATED BY*C*L")
OUTS("MEANS OF THE CONGEN OR GENOA COMPUTER-ASSISTED STRUCTURE ELUCIDATION PROGRAMS*C*L")
OUTS("STRCHK WAS DEVELOPED WITH NIH SUPPORT BY THE DENDRAL GROUP AT STANFORD.*C*L")
 IF YESNO("MAY I RECORD YOUR SESSION?:","CONGEN-HELP","YES") DO
  $(
  ENDWRITE(CREATEFILE("DSK",RECFILENAME(),CGEXT));
  RECINIT();
  FLUSHLINE();
  LINEIN("PLEASE TYPE YOUR NAME:") REPEATWHILE NEXTIS(EOLTYPE);
  UNTIL NEXTIS(EOLTYPE) DO LOPITEM()
  $)
 $);

LET LINELIST(INFN) = VALOF
 $( STATIC $( ANS = NIL $);
 ANS:=@NULL;
 UNTIL NEXTIS(EOLTYPE) DO ANS:=CONS(INFN(),ANS);
 RESULTIS DREVERSE(ANS)
 $);

LET INPR() = VALOF
 $( STATIC $( CARV = NIL; CDRV = NIL $);
 CARV:=LOPITEM();
 CDRV:=LOPITEM();
 RESULTIS CONS(CARV,CDRV)
 $);

LET ADDTOCL(ITEM,NUM,CL) = VALOF
 $( STATIC $( CLENTRY = NIL $);
 CLENTRY:=ASSOC(ITEM,CL);
 TEST CLENTRY=@NULL THEN
  $(
  CLENTRY:=CONS(ITEM,NUM);
  CL:=CONS(CLENTRY,CL)
  $)
 OR FRPLACD(CLENTRY,CDR(CLENTRY)+NUM);
 IF CDR(CLENTRY)=0 DO $( CL:=DREMOVE(CLENTRY,CL); UNCONS(CLENTRY) $);
 RESULTIS CL
 $);

GET "INTAR.BCL"

LET DEFATOM(STRNUM,VALENCE) BE
 $( STATIC $( DEFINED = NIL $);
 OPENIN(TOPFILENAME);
 OPENOUT(SC1FILENAME);
 COPYSEGSTO(CHUNKSEP,ESHEADSTR,TRUE);
 DEFINED:=COPYSEGSTO(ESSEP,STROFNUM(STRNUM),TRUE);
 TEST DEFINED THEN SKIPSEG(ESSEP)
 OR $( OUTSNUM(STRNUM); NEWLINE(1) $);
 OUTS("ATOM ");
 OUTNOL(VALENCE);
 OUTCH(ESSEP);
 UNLESS DEFINED DO NEWLINE(1);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 INTERRUPTABLE(FALSE);
 FILEREPLACE(TOPFILENAME(),CGEXT,SC1FILENAME(),CGEXT);
 OUTSNUM(STRNUM);
 TEST DEFINED THEN
  $(
  FRPLACA(CDR(CDR(ASSOC(STRNUM,ALLDEFS))),VALENCE);
  OUTS(" REDEFINED")
  $)
 OR
  $(
  ALLDEFS:=CONS(LIST(STRNUM,NUMOFSTR("ATOM"),VALENCE),ALLDEFS);
  OUTS(" DEFINED")
  $);
 NEWLINE(1);
 INTERRUPTABLE(TRUE)
 $);

LET DEFSUB(STRNUM) BE
 $(
 OPENOUT(SC1FILENAME);
 OUTS("EDIT SUBSTRUCTURE ");
 OUTSNUM(STRNUM);
 SPACES(1);
 OUTNOL(TERMTYPE);
 WRITERETTOME("STRCHK");
 LINEOUT();
 CLOSEOUT();
 STARTCGPART1(DNDPPN,"EDITS")
 $);

LET DEFTYPEOF(STRNUM) = VALOF
 $( STATIC $( DEFTYPE = NIL $);
 DEFTYPE:=ASSOC(STRNUM,ALLDEFS);
 RESULTIS (DEFTYPE=@NULL -> 0,CAR(CDR(DEFTYPE)))
 $);

LET DEFNAMEIN(PROMPT,QQSTR,TYPESTR) = VALOF
 $( STATIC $( DEFNAME = NIL; DEFTYPE = NIL; QTAB = [TABLE 2,0,0] $);
 TEST TYPESTR=0 THEN
  $(
  QTAB!1:="A NAME (OTHER THAN X OR H) WHICH HAS";
  QTAB!2:="NOT PREVIOUSLY BEEN DEFINED"
  $)
 OR
  $(
  QTAB!1:="THE NAME OF A DEFINED";
  QTAB!2:=TYPESTR
  $);
 TRYPROMPT:
 UNLESS CONDPROMPT(PROMPT,0,QTAB,QQSTR,STV) DO RESULTIS 0;
 DEFNAME:=LITEMS![LPOSN+1];
 DEFTYPE:=DEFTYPEOF(DEFNAME);
 IF [DEFNAME=XSTRNUM] BITOR [DEFNAME=HSTRNUM] DO
  $(
  OUTS("THE NAMES X AND H HAVE SPECIAL MEANINGS AND CAN'T BE USED HERE*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 IF TYPESTR=0 DO
  TEST DEFTYPE=0 THEN $( LOPITEM(); RESULTIS DEFNAME $)
  OR
   $(
   OUTSNUM(DEFNAME);
   OUTS(" IS ALREADY DEFINED AS ");
   PIART(STROFNUM(DEFTYPE));
   OUTS(" AND CAN'T BE USED HERE*C*L");
   FLUSHLINE();
   GOTO TRYPROMPT
   $);
 IF DEFTYPE=0 DO
  $( 
  OUTSNUM(DEFNAME);
  OUTS(" HASN'T BEEN DEFINED YET*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 UNLESS STREQUAL(TYPESTR,STROFNUM(DEFTYPE)) DO
  $(
  OUTS(STROFNUM(DEFNAME));
  OUTS(" IS ");
  PIART(STROFNUM(DEFTYPE));
  OUTS(" BUT I WAS EXPECTING ");
  PIART(TYPESTR);
  NEWLINE(1);
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 LOPITEM();
 RESULTIS DEFNAME
 $);

LET SUBNAMEIN(PROMPT,QQSTR) = DEFNAMEIN(PROMPT,QQSTR,"SUBSTRUCTURE");

LET VALENCE(STRNUM) = VALOF
 $( STATIC $( DEFTYPE = NIL; SAPROPENTRY = NIL $);
 DEFTYPE:=DEFTYPEOF(STRNUM);
 IF DEFTYPE=0 DO RESULTIS -1;
 IF STREQUAL("ATOM",STROFNUM(DEFTYPE)) DO
  RESULTIS CAR(CDR(CDR(ASSOC(STRNUM,ALLDEFS))))
 SAPROPENTRY:=ASSOC(STRNUM,SAPROPS);
 RESULTIS (SAPROPENTRY=@NULL -> -1,CAR(CDR(SAPROPENTRY)))
 $);

LET MFTWOU(MOLFORM) = VALOF
 $( STATIC $( TWOU = NIL $);
 TWOU:=2;
 WHILE MOLFORM NE @NULL DO
  $(
  TWOU:=TWOU+CDR(CAR(MOLFORM))*[VALENCE(CAR(CAR(MOLFORM)))-2];
  MOLFORM:=CDR(MOLFORM)
  $);
 RESULTIS TWOU
 $);

LET MFCHECK(CL) = VALOF
 $( STATIC $( TWOU = NIL; HCOUNT = NIL; HMAX = NIL; LMAX = NIL; SUMV = NIL;
              SUMHMAX = NIL; XMAX = NIL; XMAXH = NIL; XMAXAT = NIL; NNONH = NIL;
              MAXFLEX = NIL; AQPR = NIL; ATQ = NIL; SAPROPENTRY = NIL; V = NIL;
              LMIN = NIL; X = NIL; ATNAME = NIL $);
 TWOU:=2;
 HCOUNT:=0;
 SUMV:=0;
 SUMHMAX:=0;
 XMAX:=0;
 NNONH:=0;
 MAXFLEX:=FALSE;
 WHILE CL NE @NULL DO
  $(
  AQPR:=CAR(CL);
  CL:=CDR(CL);
  ATNAME:=CAR(AQPR);
  ATQ:=CDR(AQPR);
  SAPROPENTRY:=CDR(ASSOC(ATNAME,SAPROPS));
  TEST SAPROPENTRY=@NULL THEN
   $(
   V:=CAR(CDR(CDR(ASSOC(ATNAME,ALLDEFS))));
   HMAX:=V-1;
   MAXFLEX:=TRUE;
   LMIN:=0;
   LMAX:=0
   $)
  OR
   $(
   LMIN:=CAR(CDR(CDR(SAPROPENTRY)));
   LMAX:=CAR(CDR(CDR(CDR(SAPROPENTRY))))-LMIN;
   V:=CAR(SAPROPENTRY)-2*LMIN;
   HMAX:=CAR(CDR(SAPROPENTRY));
   IF HMAX>V-1 DO $( HMAX:=V-1; MAXFLEX:=TRUE $)
   $);
  TEST ATNAME=HSTRNUM THEN $( HCOUNT:=ATQ; TWOU:=TWOU-ATQ $)
  OR
   $(
   NNONH:=NNONH+ATQ;
   SUMV:=SUMV+ATQ*V
   SUMHMAX:=SUMHMAX+ATQ*HMAX;
   TWOU:=TWOU+ATQ*[V-2];
   X:=V-LMAX;
   IF X>XMAX DO $( XMAX:=X; XMAXH:=HMAX; XMAXAT:=ATNAME $);
   $)
  $);
 IF [NNONH=1] BITAND MAXFLEX DO $( SUMHMAX:=SUMHMAX+1; XMAXH:=XMAXH+1 $);
 IF TWOU<0 DO RESULTIS -1;
 IF [TWOU REM 2]=1 DO RESULTIS -2;
 IF HCOUNT>SUMHMAX DO RESULTIS -3;
 IF XMAX>0 DO
  $(
  IF XMAXH>HCOUNT DO XMAXH:=HCOUNT;
  IF 2*XMAX>SUMV+XMAXH DO RESULTIS XMAXAT
  $);
 RESULTIS 0
 $);

LET DEFMOLF(QQSTR) = VALOF
 $( STATIC $( NEWMOLF = NIL; NEWATS = NIL; ATNAME = NIL; ATVLNC = NIL;
              DTYPE = NIL; REDEF = NIL; MFERR = NIL $);
 NEWMOLF:=@NULL;
 NEWATS:=@NULL;
 IF CAR(STRUCSTATUS)>0 DO
  $(
  OUTS("NOTE: CHANGING THE MOLECULAR FORMULA AT THIS POINT MAY LEAD TO*C*L");
  OUTS("CONFUSION, SINCE YOUR STRUCTURES STILL REFLECT THE OLD FORMULA*C*L");
  UNLESS YESNO("SHALL I PROCEED ANYWAY?:",QQSTR,"NO") DO RETURN
  $);
 TRYPROMPT:
 UNLESS CONDPROMPT("MOLECULAR FORMULA:",0,[TABLE 2,
  "A LIST OF ATOM NAMES AND QUANTITIES (ONES MAY BE OMITTED), SEPARATED",
  "BY BLANKS OR COMMAS (E.G., C 4 H 5 BR)"],QQSTR,STV) DO
  RESULTIS FALSE;
 NEXTNAME:
 UNLESS NEXTIS(STRTYPE) DO
  $( OUTS("I WAS EXPECTING A WORD HERE*C*L"); GOTO REPROMPT $);
 IF BADNAME([TABLE 1,"X"],
            "PLEASE DON'T USE THE NAME X IN THE MOLECULAR FORMULA") DO
  GOTO REPROMPT;
 ATNAME:=LOPITEM();
 DTYPE:=DEFTYPEOF(ATNAME);
 TEST DTYPE=0 THEN NEWATS:=CONS(ATNAME,NEWATS)
 OR
  UNLESS STREQUAL("ATOM",STROFNUM(DTYPE)) DO
   $(
   OUTSNUM(ATNAME);
   OUTS(" IS ");
   PIART(STROFNUM(DTYPE));
   OUTS(" AND CAN'T BE USED IN THE MOLECULAR FORMULA*C*L");
   GOTO REPROMPT
   $);
 NEWMOLF:=CONS(CONS(ATNAME,(NEXTIS(NUMTYPE) -> LOPITEM(),1)),NEWMOLF);
 UNLESS NEXTIS(EOLTYPE) BITOR NEXTIS(PSEOLTYPE) DO GOTO NEXTNAME;
 IF NEXTIS(PSEOLTYPE) DO LOPITEM();
 NEWATS:=DREVERSE(NEWATS)
 WHILE NEWATS NE @NULL DO
  $(
  ATNAME:=CAR(NEWATS);
  NEWATS:=UNCONS(NEWATS);
  OUTS("DEFINING ATOM ");
  OUTSNUM(ATNAME);
  OUTS("...*C*L");
  ATVLNC:=GETPOSINT("VALENCE:",QQSTR,FALSE);
  IF ATVLNC<0 DO GOTO REPROMPT;
  DEFATOM(ATNAME,ATVLNC)
  $);
 MFERR:=MFCHECK(NEWMOLF)
 IF MFERR NE 0 DO
  $(
  SWITCHON MFERR INTO
   $(
   CASE -1:
    OUTS("CONNECTED STRUCTURES CAN'T BE BUILT FROM THAT FORMULA*C*L");
    ENDCASE;
   CASE -2:
    OUTS("THAT FORMULA IMPLIES AN UNPAIRED ELECTRON ON SOME ATOM*C*L");
    ENDCASE;
   CASE -3:
    OUTS("PROGRAM ERROR - CONTACT CONGEN DEVELOPERS*C*L");
    ENDCASE;
   DEFAULT:
    OUTS("IN THAT FORMULA, THERE IS NO WAY TO SATISFY THE VALENCE OF ");
    OUTSNUM(MFERR);
    NEWLINE(1)
   $);
  GOTO REPROMPT
  $);
 NEWMOLF:=DREVERSE(NEWMOLF);
 REDEF:=[MOLFORM NE @NULL];
 MAPC(MOLFORM,UNCONS);
 UNLIST(MOLFORM);
 MOLFORM:=NEWMOLF;
 OPENIN(TOPFILENAME);
 OPENOUT(SC1FILENAME);
 COPYSEGSTO(CHUNKSEP,MFHEADSTR,TRUE);
 SKIPSEG(CHUNKSEP);
 WHILE NEWMOLF NE @NULL DO
  $(
  OUTSNUM(CAR(CAR(NEWMOLF)));
  SPACES(1);
  OUTNOS(CDR(CAR(NEWMOLF)));
  NEWMOLF:=CDR(NEWMOLF)
  $);
 NEWLINE(1);
 OUTCH(CHUNKSEP);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 INTERRUPTABLE(FALSE);
 FILEREPLACE(TOPFILENAME(),CGEXT,SC1FILENAME(),CGEXT);
 OUTS("MOLECULAR FORMULA ");
 IF REDEF THEN OUTS("RE");
 OUTS("DEFINED*C*L");
 INTERRUPTABLE(TRUE);
 RESULTIS TRUE;
 REPROMPT:
 UNLIST(NEWATS);
 NEWATS:=@NULL;
 MAPC(NEWMOLF,UNCONS);
 UNLIST(NEWMOLF);
 NEWMOLF:=@NULL;
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET CHANGEWARN(STRNUM,CONFIRMFLAG,QQSTR) = VALOF
//A VALUE OF FALSE HERE MEANS THAT IT IS OK TO CHANGE THE DEFINITION OF THE
//ITEM NAMED BY STRNUM (DETERMINED BY CONFIRMATION IF CONFIRMFLAG).
//A TRUE VALUE MEANS THE CHANGE SHOULDN'T BE DONE (IF CONFIRMFLAG) OR MAY
//BE RISKY (IF [NOT CONFIRMFLAG]) - IE, THE USER HAS BEEN WARNED AGAINST IT
 $( STATIC $( ERRTYPE = NIL $);
 ERRTYPE:=(ASSOC(STRNUM,MOLFORM) NE @NULL -> 1,
           (ASSOC(STRNUM,CDR(CDR(STRUCSTATUS))) NE @NULL -> 2,0));
 IF ERRTYPE=0 DO RESULTIS FALSE;
 OUTS("NOTE: CHANGING OR FORGETTING THE DEFINITION OF ");
 OUTSNUM(STRNUM);
 OUTS(" AT THIS POINT MAY*C*L");
 OUTS("LEAD TO CONFUSION BECAUSE ");
 OUTS((ERRTYPE=1 -> "THAT ATOM APPEARS IN YOUR MOLECULAR FORMULA*C*L",
                    "YOUR STRUCTURES STILL REFLECT THE OLD DEFINITION*C*L"));
 RESULTIS (CONFIRMFLAG -> [NOT YESNO("SHALL I PROCEED ANYWAY?:",QQSTR,"NO")],
                          TRUE)
 $);


LET DEFTT(QQSTR) BE
 $( STATIC $( NTT = NIL $);
 OUTS("OLD TERMINAL TYPE IS ");
 OUTNOL(TERMTYPE);
 TRYPROMPT:
 UNLESS CONDPROMPT("NEW TERMINAL TYPE:",0,
     [TABLE 15,
     "3 FOR MEGATEK, 4 FOR TEKTRONIX, 5 FOR GT40,",
     "OR FOR TELETYPE DRAWINGS,",
     "SELECT THE NUMBER CORRESPONDING TO THE DRAWING BELOW WHICH LOOKS",
     "MOST LIKE TETRAHEDRANE:",
     "1     C",
     "     /|\",
     "    C--*B|-C",
     "     \|/",
     "      C",
     "",
     "2     C",
     "     /!\",
     "    C---C*C      !",
     "     \!/",
     "      C"],                          QQSTR,NTV) DO RETURN;
 NTT:=LOPITEM();
 IF [NTT<1] BITOR [NTT>5] DO
  $(
  OUTS("I DON'T UNDERSTAND - TYPE ? FOR HELP*C*L");
  FLUSHLINE();
  GOTO TRYPROMPT
  $);
 OPENIN(TOPFILENAME);
 OPENOUT(SC1FILENAME);
 COPYSEGSTO(CHUNKSEP,TTHEADSTR,TRUE);
 OUTNOL(NTT);
 OUTCH(CHUNKSEP);
 SKIPSEG(CHUNKSEP);
 COPYTOEND();
 CLOSEIN();
 CLOSEOUT();
 INTERRUPTABLE(FALSE);
 FILEREPLACE(TOPFILENAME(),CGEXT,SC1FILENAME(),CGEXT);
 TERMTYPE:=NTT;
 OUTS("THE TERMINAL TYPE HAS BEEN RESET TO ");
 OUTNOL(NTT);
 INTERRUPTABLE(TRUE)
 $);



LET CGDEFINE(FIXFLAG) BE
 $( STATIC $( DEFTYPE = NIL; DEFNAME = NIL; VALENCE = NIL; QQSTR = NIL $);
 QQSTR:=(FIXFLAG -> "FIX-HELP","DEFINE-HELP");
 DEFTYPE:=PROMPTSELECT("DEFINITION TYPE:",
                       "ATOM SUBSTRUCTURE AROMATICS MOLFORM TERMTYPE",
                       0,QQSTR,[TABLE 5,"ATOM",1,"SUBSTRUCTURE",2,
                       "AROMATICS",3,"MOLFORM",4,"TERMTYPE",5,0],FALSE);
 IF DEFTYPE=0 DO RETURN;
 IF DEFTYPE=3 DO $( CHANGEARLIST(FIXFLAG,QQSTR); RETURN $);
 IF DEFTYPE=5 DO $( DEFTT(QQSTR); RETURN $);
 IF DEFTYPE=4 DO
  TEST FIXFLAG THEN
   TEST MOLFORM=@NULL THEN
    $(
    OUTS("THE MOLECULAR FORMULA HASN'T BEEN DEFINED YET*C*L");
    FLUSHLINE();
    RETURN
    $)
   OR $( DEFMOLF(QQSTR); RETURN $)
  OR
   TEST MOLFORM=@NULL THEN $( DEFMOLF(QQSTR); RETURN $)
   OR
    $(
    OUTS("THE MOLECULAR FORMULA IS ALREADY DEFINED.  PLEASE USE THE*C*L");
    OUTS("FIX COMMAND IF YOU WANT TO CHANGE IT.*C*L");
    FLUSHLINE();
    RETURN
    $);
 DEFNAME:=DEFNAMEIN("NAME:",QQSTR,
                    (FIXFLAG -> (DEFTYPE=1 -> "ATOM","SUBSTRUCTURE"),0));
 IF DEFNAME=0 DO RETURN;
 IF FIXFLAG DO
  IF CHANGEWARN(DEFNAME,TRUE,QQSTR) DO $( FLUSHLINE(); RETURN $);
 SWITCHON DEFTYPE INTO
  $(
  CASE 1:
   VALENCE:=GETPOSINT("VALENCE:",QQSTR,FALSE);
   IF VALENCE=-1 DO RETURN;
   DEFATOM(DEFNAME,VALENCE);
   ENDCASE;
  CASE 2:
   DEFSUB(DEFNAME)
  $)
 $);

LET RANGEREADER(PROMPT,QQSTR,POSMINFLAG) = VALOF
 $( STATIC $( RTYPE = NIL; NUM = NIL; NUM2 = NIL; OPTIONS =
      "NONE     AT LEAST X     AT MOST X     EXACTLY X     RANGE X TO Y";
              POSMINOPTIONS = "AT LEAST X     EXACTLY X     RANGE X TO Y";
              OPTTABLE = [TABLE 6, "NONE",1,"LEAST",2,"MOST",3,"EXACTLY",4,
              "RANGE",5,"AT",6,0]; POSMINOPTTABLE = [TABLE 4,"LEAST",2,
              "EXACTLY",4,"RANGE",5,"AT",6,0]; QTABLE = [TABLE 4,
     "PLEASE GIVE ME A RANGE IN ONE OF THE FOLLOWING FORMS:",0,
     "WHERE X AND Y ARE POSITIVE INTEGERS (LESS THAN 100) WHICH YOU SUPPLY",
     "THE WORDS 'AT' AND 'TO' ARE OPTIONAL"] $);
 QTABLE!2:=(POSMINFLAG -> POSMINOPTIONS,OPTIONS);
 TRYPROMPT:
 RTYPE:=PROMPTSELECT(PROMPT,0,QTABLE,QQSTR,(POSMINFLAG -> POSMINOPTTABLE,
                      OPTTABLE),FALSE);
 SWITCHON RTYPE INTO
  $(
  CASE 0: RESULTIS @NULL;
  CASE 1: RESULTIS CONS(0,0);
  CASE 6:
   TEST POSMINFLAG THEN
    $(
    TEST NEXTIS(STRTYPE) THEN
     TEST STRCONTAIN(STROFNUM(LITEMS![LPOSN+1]),"LEAST") THEN LOPITEM()
     OR GOTO REPROMPT
    OR OUTS("I ASSUME YOU MEAN 'AT LEAST'*C*L");
    RTYPE:=2
    $)
   OR
    $(
    RTYPE:=PROMPTSELECT("LEAST OR MOST?:","LEAST MOST",0,QQSTR,
                        [TABLE 2,"LEAST",2,"MOST",3,0],FALSE);
    IF RTYPE=0 DO GOTO REPROMPT
    $)
  $);
 NUM:=GETPOSINT((RTYPE=5 -> "BEGINNING OF RANGE:","NUMBER:"),QQSTR,FALSE);
 IF [NUM<0] BITOR [NUM GE 100] DO GOTO REPROMPT;
 SWITCHON RTYPE INTO
  $(
  CASE 2: RESULTIS CONS(NUM,100);
  CASE 3: RESULTIS CONS(0,NUM);
  CASE 4: RESULTIS CONS(NUM,NUM)
  $);
 IF NEXTIS(STRTYPE) DO
  UNLESS STRCONTAIN(STROFNUM(LOPITEM()),"TO") DO GOTO REPROMPT;
 NUM2:=GETPOSINT("END OF RANGE:",QQSTR,FALSE);
 IF [NUM2>0] BITOR [NUM2 GE 100] DO
  RESULTIS (NUM2>NUM -> CONS(NUM,NUM2),CONS(NUM2,NUM));
 REPROMPT:
 OUTS("I DON'T UNDERSTAND - TYPE ? FOR HELP*C*L");
 FLUSHLINE();
 GOTO TRYPROMPT
 $);

LET CONSTRAINTIN(QQSTR) = VALOF
 $( STATIC $( CONTYPE = NIL; CONID = NIL; CONMINMAX = NIL $);
 TRYPROMPT:
 CONTYPE:=PROMPTSELECT("CONSTRAINT:",0,[TABLE 2,
     "FIRST, I NEED TO KNOW THE CONSTRAINT TYPE, ONE OF THE FOLLOWING:",
     "SUBSTRUCTURE PROTON RING LOOP PARTIAL"],QQSTR,[TABLE 5,"SUBSTRUCTURE",
     SUBCONTYPE,"PROTON",PROTCONTYPE,"RING",RINGCONTYPE,"LOOP",LOOPCONTYPE,
     "PARTIAL",PARTCONTYPE,0],FALSE);
 IF CONTYPE=0 DO RESULTIS @NULL;
 SWITCHON CONTYPE INTO
  $(
  CASE PARTCONTYPE:
   STOPAFTER:=GETPOSINT("MAXIMUM NUMBER OF STRUCTURES TO BE PRODUCED:",QQSTR,
                        FALSE)
   IF STOPAFTER<0 DO GOTO REPROMPT;
   GOTO TRYPROMPT;
   ENDCASE;
  CASE LOOPCONTYPE:
   CONID:=SUBNAMEIN("SUPERATOM:",QQSTR);
   IF CONID=0 DO GOTO REPROMPT;
   IF ASSOC(CONID,MODMF)=@NULL DO
    $(
    OUTS("TESTING FOR THE NUMBER OF INTERNAL BONDS IN ");
    OUTSNUM(CONID);
    OUTS("*C*LDOESN'T MAKE SENSE HERE BECAUSE THAT SUBSTRUCTURE NAME*C*L");
    OUTS("WILL NOT BE PRESENT WHEN I APPLY THE TEST.*C*L");
    GOTO REPROMPT
    $);
   ENDCASE;
  CASE SUBCONTYPE: CASE PROTCONTYPE:
   CONID:=SUBNAMEIN("SUBSTRUCTURE NAME:",QQSTR);
   IF CONID=0 DO GOTO REPROMPT;
   ENDCASE;
  CASE RINGCONTYPE:
   CONID:=GETPOSINT("RING SIZE:",QQSTR,FALSE);
   IF CONID<2 DO GOTO REPROMPT
  $);
 CONMINMAX:=RANGEREADER("RANGE OF OCCURRENCES:",QQSTR,FALSE);
 IF CONMINMAX NE @NULL DO
  $(
  FRPLACD(CONMINMAX,CONS(CDR(CONMINMAX),@NULL));
  RESULTIS CONS(CONTYPE,CONS(CONID,CONMINMAX))
  $);
 REPROMPT:
 OUTS("EH?*C*L");
 GOTO TRYPROMPT
 $);

LET FETCHSUB(SUBNAME) BE
 $(
 OPENIN(TOPFILENAME);
 FINDSEG(CHUNKSEP,ESHEADSTR);
 FINDSEG(ESSEP,STROFNUM(SUBNAME));
 SKIPSEG('*L');
 READESSTRUC();
 CLOSEIN()
 $);

LET ARATOMPRESENT(ATNAME) =
 (MODARLIST=@NULL -> FALSE,
  (ATNAME=XSTRNUM -> TRUE,
   (ASSOC(ATNAME,MODMF)=@NULL -> FALSE,CANBEAROM(ATNAME,MODARLIST))));

LET ATOMPRESENT(ATNAME) =
 (ATNAME=XSTRNUM -> TRUE,[ASSOC(ATNAME,MODMF) NE @NULL]);

LET CTEATOMSABSENT(CTE) = VALOF
 $( STATIC $( TATS = NIL; TATAIL = NIL; PRES = NIL $);
 TATS:=FETCH(CTE.ATS,CTE);
 TATAIL:=TATS;
 PRES:=@NULL;
  $(
  TATAIL:=SOME(TATAIL,(ARP(CTE) -> ARATOMPRESENT,ATOMPRESENT));
  IF TATAIL=@NULL DO BREAK;
  PRES:=CONS(CAR(TATAIL),PRES);
  TATAIL:=CDR(TATAIL)
  $) REPEAT;
 IF PRES=@NULL DO RESULTIS TRUE;
 UNLIST(TATS);
 REPLACE(CTE.ATS,CTE,PRES);
 RESULTIS FALSE
 $);

LET PNOSENSE(STRNUM) BE
 $(
 OUTS("TESTING FOR ");
 OUTSNUM(STRNUM);
 OUTS(" DOESN'T MAKE SENSE HERE BECAUSE*C*L")
 $);

LET CONATOMSPRESENT(TELLUSER,CNSTRNUM) = VALOF
 $( STATIC $( ERRATS = NIL; TCTELIST = NIL; COLORED = NIL; HYBRIDED = NIL $);
 COLORED,HYBRIDED:=FALSE,FALSE
 TCTELIST:=CTELIST;
 ERRATS:=@NULL;
 WHILE TCTELIST NE @NULL DO
  $(
  if COLOURP(CAR(TCTELIST)) then COLORED:=TRUE
  if HYBRIDSPECP(CAR(TCTELIST)) then HYBRIDED:=TRUE
  IF CTEATOMSABSENT(CAR(TCTELIST)) DO
   ERRATS:=CONS(FETCH(CTE.NUM,CAR(TCTELIST)),ERRATS);
  TCTELIST:=CDR(TCTELIST)
  $);

 IF ERRATS=@NULL DO $(OK
   /* substructure basically OK, but print warnings about any color
  or hybridization tags.
  */
    if TELLUSER & COLORED then $(
	OUTS("(color tags on atoms in ");
	OUTSNUM(CNSTRNUM)
	OUTS(" will of course be ignored)*C*L")
	$)

    if TELLUSER & HYBRIDED then $(
	OUTS("(hybridization tags on atoms in ");
	OUTSNUM(CNSTRNUM)
	OUTS(" will of course be ignored)*C*L")
	$)

   RESULTIS TRUE
   $)OK

 UNLESS TELLUSER DO $( UNLIST(ERRATS); RESULTIS FALSE $);
 PNOSENSE(CNSTRNUM);
 OUTS((CDR(ERRATS)=@NULL -> "ATOM","ATOMS"));
 PLIST(ERRATS,OUTNO," ",", "," AND "," CAN'T MATCH ANY OF THE ATOMS WHICH*C*L");
 OUTS("WILL BE PRESENT WHEN I APPLY THE TEST*C*L");
 RESULTIS FALSE
 $);

GET "SSCHEK.BCL"

LET ONETAGP(STRNUM) = VALOF
 $( STATIC $( TAGTAIL = NIL $);
 TAGTAIL:=SOME(CTELIST,TAGP);
 IF TAGTAIL NE @NULL DO
  IF SOME(CDR(TAGTAIL),TAGP)=@NULL DO RESULTIS TRUE;
 OUTS("PROTON-CONSTRAINT SUBSTRUCTURES SHOULD HAVE EXACTLY ONE TAG, BUT*C*L");
 OUTSNUM(STRNUM);
 OUTS((TAGTAIL=@NULL -> " DOESN'T HAVE ANY.*C*L"," HAS MORE THAN ONE.*C*L"));
 FLUSHLINE();
 RESULTIS FALSE
 $);

LET CONSTRAINTCHECK(TELLUSER,STRNUM,PTFLAG) = VALOF
 $( STATIC $( CONCOMP = NIL; DEFICITS = NIL; AQPR = NIL $);
 IF PTFLAG DO UNLESS ONETAGP(STRNUM) DO RESULTIS FALSE;
 UNLESS CONATOMSPRESENT(TELLUSER,STRNUM) DO RESULTIS FALSE;
 CONCOMP:=SSCHECK(STRNUM,"I CAN'T USE ",FALSE);
 IF CONCOMP=0 DO RESULTIS FALSE;
 DEFICITS:=@NULL;
 WHILE CONCOMP NE @NULL DO
  $(
  AQPR:=CAR(CONCOMP);
  CONCOMP:=UNCONS(CONCOMP);
  IF CDR(AQPR)>CDR(ASSOC(CAR(AQPR),MODMF)) DO
   DEFICITS:=CONS(CAR(AQPR),DEFICITS);
  UNCONS(AQPR)
  $);
 IF DEFICITS NE @NULL DO
  $(
  IF TELLUSER DO
   $(
   PNOSENSE(STRNUM);
   OUTS("IT CONTAINS MORE ATOMS OF TYPE");
   IF CDR(DEFICITS) NE @NULL DO OUTCH('S');
   PLIST(DEFICITS,OUTSNUM," ",", "," AND ","*C*L");
   OUTS("THAN WILL BE PRESENT WHEN I APPLY THE TEST*C*L")
   $);
  UNLIST(DEFICITS);
  RESULTIS FALSE
  $);
 RESULTIS TRUE
 $);

LET WRITECNR(CNR,TELLUSER,OUTFILE) = VALOF
 $( STATIC $( OOUT = NIL; PTFLAG = NIL; ANS = NIL $);
 PTFLAG:=[CAR(CNR)=PROTCONTYPE];
 CNR:=CDR(CNR);
 FETCHSUB(CAR(CNR));
 ANS:=FALSE;
 IF CONSTRAINTCHECK(TELLUSER,CAR(CNR),PTFLAG) DO
  $(
  ANS:=TRUE;
  CONLENGTHS:=CONS(LENGTH(CTELIST),CONLENGTHS);
  OOUT:=OUTPUT;
  OUTPUT:=OUTFILE;
  PASSESSTRUCOUT();
  OUTS((PTFLAG -> "Y*C*L","N*C*L"));
  OUTNOL(CAR(CDR(CNR)));
  OUTNOL(CAR(CDR(CDR(CNR))));
  OUTPUT:=OOUT
  $);
 CLEAR();
 RESULTIS ANS
 $);

LET RANGEOUT(MIN,MAX,NONEFLAG) = VALOF
 $(
 IF MAX=0 DO $( OUTS((NONEFLAG -> "NONE","NO")); RESULTIS TRUE $);
 IF MAX=100 DO $( OUTS("AT LEAST "); OUTNO(MIN); RESULTIS [MIN NE 1] $);
 IF MIN=0 DO $( OUTS("AT MOST "); OUTNO(MAX); RESULTIS [MAX NE 1] $);
 IF MIN=MAX DO $( OUTS("EXACTLY "); OUTNO(MIN); RESULTIS [MIN NE 1] $);
 OUTS("FROM "); OUTNO(MIN); OUTS(" TO "); OUTNO(MAX); RESULTIS TRUE
 $);

LET RESETLOOPMM(STRNUM,NLMIN,NLMAX) = VALOF
 $( STATIC $( SAPROPTAIL = NIL; LMIN = NIL; LMAX = NIL; OLMAX2 = NIL;
              ANYCHANGE = NIL; OLMIN = NIL; OLMAX = NIL $);

 LET LMSG(STRNUM,NLMIN,NLMAX,STR) BE
  $(
  OUTS("MY INFORMATION SHOWS ");
  OUTSNUM(STRNUM);
  OUTS(" AS HAVING ");
  OUTS((RANGEOUT(OLMIN,OLMAX,FALSE) -> " LOOPS,*C*L"," LOOP,*C*L"));
  OUTS(STR);
  RANGEOUT(NLMIN,NLMAX,TRUE);
  OUTS(".*C*L");
  $);

 SAPROPTAIL:=CDR(CDR(CDR(ASSOC(STRNUM,SAPROPS))));
 OLMIN:=CAR(SAPROPTAIL);
 LMIN:=OLMIN;
 OLMAX:=CAR(CDR(SAPROPTAIL));
 OLMAX2:=[VALENCE(STRNUM) -
         ([[CDR(MODMF)=@NULL] BITAND [CDR(CAR(MODMF))=1]] -> 0,1)]/2;
 IF OLMAX>OLMAX2 DO OLMAX:=OLMAX2;
 LMAX:=OLMAX;
 ANYCHANGE:=FALSE;
 IF NLMIN>LMIN DO $( LMIN:=NLMIN; ANYCHANGE:=TRUE $);
 IF NLMAX<LMAX DO $( LMAX:=NLMAX; ANYCHANGE:=TRUE $);
 UNLESS ANYCHANGE DO
  $(
  LMSG(STRNUM,NLMIN,NLMAX,"SO I WON'T BOTHER TESTING FOR ");
  RESULTIS 0
  $);
 IF LMIN>LMAX DO
  $(
  LMSG(STRNUM,NLMIN,NLMAX,"SO THERE CANNOT ALSO BE ");
  RESULTIS -1
  $);
 FRPLACA(SAPROPTAIL,LMIN);
 FRPLACA(CDR(SAPROPTAIL),LMAX)
 RESULTIS 1
 $);

LET LOOPTESTOUT(MODMF,OUTFILE) BE
 $( STATIC $( OOUT = NIL; SAPROPENTRY = NIL; NAME = NIL $);
 OOUT:=OUTPUT;
 OUTPUT:=OUTFILE;
 OUTNOL(LENGTH(MODMF)-(ASSOC(HSTRNUM,MODMF)=@NULL -> 0,1));
 WHILE MODMF NE @NULL DO
  $(
  NAME:=CAR(CAR(MODMF));
  MODMF:=CDR(MODMF);
  IF NAME=HSTRNUM DO LOOP;
  OUTSNUM(NAME);
  SAPROPENTRY:=ASSOC(NAME,SAPROPS);
  IF SAPROPENTRY=@NULL DO $( OUTS(" 0 0*C*L"); LOOP $);
  SAPROPENTRY:=CDR(CDR(CDR(SAPROPENTRY)));
  SPACES(1);
  OUTNOS(CAR(SAPROPENTRY));
  OUTNOL(CAR(CDR(SAPROPENTRY)))
  $);
 OUTPUT:=OOUT
 $);

LET CONREQLOOP(QQSTR,OUTFILE) = VALOF
 $( STATIC $( CNR = NIL; QQS = NIL; SOMECONSTRAINT = NIL $);

 LET GETCNR() = VALOF
  $(
  NEXTCN:
  CNR:=CONSTRAINTIN(QQS);
  IF CNR=@NULL DO RESULTIS FALSE;
  SWITCHON CAR(CNR) INTO
   $(
   CASE RINGCONTYPE:
    CNR:=UNCONS(CNR);
    TEST ASSOC(CAR(CNR),RINGCONS)=@NULL THEN
     $(
     SOMECONSTRAINT:=TRUE;
     RINGCONS:=CONS(CNR,RINGCONS)
     $)
    OR
     $(
     OUTS("YOU HAVE ALREADY SPECIFIED A TEST FOR RINGS OF SIZE ");
     OUTNO(CAR(CNR));
     OUTS(".*C*LFURTHER TESTS INVOLVING THIS RING SIZE WILL BE IGNORED.*C*L");
     UNLIST(CNR);
     FLUSHLINE();
     $);
    GOTO NEXTCN;
   CASE LOOPCONTYPE:
    CNR:=UNCONS(CNR);
    SWITCHON RESETLOOPMM(CAR(CNR),CAR(CDR(CNR)),CAR(CDR(CDR(CNR)))) INTO
     $( CASE 1: SOMECONSTRAINT:=TRUE; ENDCASE; CASE 0: CASE -1: FLUSHLINE() $);
    UNLIST(CNR);
    GOTO NEXTCN;
   DEFAULT: RESULTIS TRUE
   $)
  $);

 SOMECONSTRAINT:=FALSE;
 WHILE INTERNALCONS NE @NULL DO
  $(
  IF WRITECNR(CAR(INTERNALCONS),FALSE,OUTFILE) DO SOMECONSTRAINT:=TRUE;
  UNLIST(CAR(INTERNALCONS));
  INTERNALCONS:=UNCONS(INTERNALCONS)
  $);
 QQS:=QQSTR;
 WHILE GETCNR() DO
  $(
  IF WRITECNR(CNR,TRUE,OUTFILE) DO SOMECONSTRAINT:=TRUE;
  UNLIST(CNR)
  $);
 RESULTIS SOMECONSTRAINT
 $);

LET AVOUT(MFENTRY) BE
 $( STATIC $( ATNAME = NIL $);
 ATNAME:=CAR(MFENTRY);
 OUTSNUM(ATNAME);
 SPACES(1);
 OUTNO(VALENCE(ATNAME))
 $);

LET COPYCL(CL) = VALOF
 $( STATIC $( CLCOPY = NIL $);
 CLCOPY:=@NULL;
 WHILE CL NE @NULL DO
  $(
  CLCOPY:=CONS(CONS(CAR(CAR(CL)),CDR(CAR(CL))),CLCOPY);
  CL:=CDR(CL)
  $);
 CLCOPY:=DREVERSE(CLCOPY);
 RESULTIS CLCOPY
 $);

LET PRINATN(PR) BE $( OUTSNUM(CAR(PR)); SPACES(1); OUTNO(CDR(PR)) $);

LET CLEANSAPROP(SAPROP) BE
 $( STATIC $( COMP = NIL $);
 COMP:=CAR(LAST(SAPROP));
 MAPC(COMP,UNCONS);
 UNLIST(COMP);
 UNLIST(SAPROP)
 $);

GET "SETFNS.BCL"
GET "CYCLES.BCL"
GET "DANDC.BCL"
GET "RCOUT.BCL"

LET MAKEMODAR(MFU) BE
 $( STATIC $( TARLIST = NIL; ARIX = NIL; ARENTRY = NIL $);
 MODARLIST:=@NULL;
 TARLIST:=ARLIST;
 WHILE TARLIST NE @NULL DO
  $(
  ARENTRY:=CAR(TARLIST);
  ARIX:=CDR(ARENTRY);
  TARLIST:=CDR(TARLIST);
  IF MFU<ARUTABLE!ARIX DO LOOP;
  UNLESS ARCLCONTAIN(ARIX,MODMF) DO LOOP;
  MODARLIST:=CONS(ARENTRY,MODARLIST)
  $);
 IF ARLIST NE @NULL DO
  $(
  OUTS("PERTINENT AROMATIC TEMPLATES:");
  TEST MODARLIST=@NULL THEN OUTS("NONE*C*L")
  OR
   PLIST(MODARLIST,OUTSNUMCAR,(LENGTH(MODARLIST)>4 -> "*C*L",""),
          ", "," AND ","*C*L")
  $)
 $);

STATIC $( THISPARTSTR = "STRCHK" $);

GET "PFILE.BCL"

LET SAVECHECK(QQSTR) = VALOF
 $( STATIC $( WARNED = NIL $);
 IF STOPAFTER<0 DO RESULTIS TRUE;
 IF PARTIALFLAG DO RESULTIS TRUE;
 IF YESNO("HAVE YOU SAVED YOUR CURRENT SESSION ON FILE?:",QQSTR,"NO") DO
  RESULTIS TRUE;
 WARNED:=FALSE;
 TRYPROMPT:
 IF YESNO("DO YOU WANT TO SAVE YOUR SESSION NOW?:",QQSTR,"YES") DO
  TEST SAVE() THEN RESULTIS TRUE OR GOTO TRYPROMPT;
 IF WARNED DO RESULTIS FALSE;
 WARNED:=TRUE;
 OUTS("YOU ARE USING THE 'PARTIAL' CONSTRAINT, SO THE STRUCTURE LIST I*C*L");
 OUTS("PRODUCE WILL BE INCOMPLETE.  YOU WILL PROBABLY WANT TO REDO THIS*C*L");
 OUTS("CALCULATION LATER WITHOUT THE 'PARTIAL' CONSTRAINT.  I STRONGLY*C*L");
 OUTS("SUGGEST SAVING YOUR SESSION SO YOU CAN RESTORE IT LATER.*C*L");
 GOTO TRYPROMPT
 $);


GET "CHKOSA.BCL"

LET PRUNE() BE
 $( STATIC $( OUTFILE = NIL; OOUT = NIL; OIN = NIL $);
 INTERNALCONS:=@NULL;
 SAPROPS:=@NULL;
 CONLENGTHS:=@NULL;
 RINGCONS:=@NULL;
 IF CAR(STRUCSTATUS)=0 DO
  $(
  OUTS("THERE ARE NO STRUCTURES TO PRUNE*C*L");
  RETURN
  $);

 IF STEREOSTRUCS THEN $(
   UNLESS YESNO("THE PRUNE OPTIONS IN STEREO WOULD BE MORE APPROPRIATE*C*LDO YOU REALLY WANT STANDARD PRUNE? ","CONGEN-HELP","NO")
     DO RETURN
   $)

 MODMF:=CHECKOLDSAS(CDR(CDR(STRUCSTATUS)),CAR(CDR(STRUCSTATUS)));
 IF MODMF=0 DO
  $(
  MODMF:=@NULL;
  GOTO CLEANOUT
  $);
 MAKEMODAR(MFTWOU(MODMF)/2);
 OUTFILE:=CREATEFILE("DSK",SC1FILENAME(),CGEXT);
 STOPAFTER:=-1;
 UNLESS CONREQLOOP("PRUNE-HELP",OUTFILE) DO
  $(
  OUTS("NO CONSTRAINTS WERE GIVEN*C*L");
  ENDWRITE(OUTFILE);
  DELETEFILE(SC1FILENAME(),CGEXT);
  GOTO CLEANOUT
  $);
 LOOPTESTOUT(MODMF,OUTFILE);
 UNLESS OUTPUTRINGCONS(RINGCONS,MODMF,OUTFILE) DO
  $(
  ENDWRITE(OUTFILE);
  DELETEFILE(SC2FILENAME(),CGEXT);
  GOTO CLEANOUT
  $);
 SAVECHECK();
 OOUT:=OUTPUT;
 OUTPUT:=OUTFILE;
 OUTNOL(STOPAFTER);
 OUTPUT:=OOUT;
 ENDWRITE(OUTFILE);
 OUTPUT:=CREATEFILE("DSK",SC2FILENAME(),CGEXT);

 WRITERETTOME(THISPARTSTR)

 OUTNOL(LENGTH(CDR(MODMF)));
 PLIST(CDR(MODMF),AVOUT,""," "," ","*C*L");
 CONLENGTHS:=DREVERSE(CONLENGTHS);
 OUTNOL(LENGTH(CONLENGTHS));
 IF CONLENGTHS NE @NULL DO PLIST(CONLENGTHS,OUTNO,""," "," ","*C*L");
 OIN:=INPUT;
 INPUT:=FINDFILE("DSK",SC1FILENAME(),CGEXT);
 COPYTOEND();
 ENDREAD(INPUT);
 INPUT:=OIN;
 ENDWRITE(OUTPUT);
 OUTPUT:=OOUT;
 IF FILEEXISTS(STIFILENAME(),CGEXT) THEN $(
  OUTS("(DESTROYING RECORDS OF STEREOCHEMISTRY!!!!!*C*L");
  WHILE DELETEFILE(STIFILENAME(),CGEXT) DO;
  $)
 INTERRUPTABLE(FALSE);
 FILEREPLACE(SC1FILENAME(),CGEXT,SC2FILENAME(),CGEXT);
 INTERRUPTABLE(TRUE);
 STARTCGPART1(DNDPPN,"PRUNE");
 CLEANOUT:
 FLUSHLINE();
 UNLIST(MODARLIST);
 MODARLIST:=@NULL;
 MAPC(RINGCONS,UNLIST);
 UNLIST(RINGCONS);
 RINGCONS:=@NULL;
 IF MODMF NE @NULL DO
  $(
  UNCONS(CAR(MODMF));
  UNCONS(MODMF)
  $);
 MODMF:=@NULL;
 MAPC(SAPROPS,CLEANSAPROP);
 UNLIST(SAPROPS);
 SAPROPS:=@NULL;
 UNLIST(CONLENGTHS);
 CONLENGTHS:=@NULL
 $);

LET AROMATIZE() BE
 $( STATIC $( OOUT = NIL $);
 IF CAR(STRUCSTATUS)=0 DO
  $(
  OUTS("THERE ARE NO STRUCTURES TO AROMATIZE*C*L");
  FLUSHLINE();
  RETURN
  $);

// CHANGE BY JGN

   IF FILEEXISTS(STIFILENAME(),CGEXT) DO
   $( OUTS("AROMATIZING NOW WILL ELIMINATE ALL YOUR STEREOISOMERS.*C*L")
      UNLESS YESNO("DO YOU WISH TO CONTINUE AROMATIZING? ","STEREO-HELP","YES")
      DO RETURN
   $)
   IF FILEEXISTS(STIFILENAME(),CGEXT) DO DELETEFILE(STIFILENAME(),CGEXT)

// END OF CHANGE

 IF ARLIST=@NULL DO
  $(
  OUTS("YOU HAVE NO AROMATIC TEMPLATES DEFINED.*C*L");
  FLUSHLINE();
  RETURN
  $);
 MODMF:=CHECKOLDSAS(CDR(CDR(STRUCSTATUS)),CAR(CDR(STRUCSTATUS)));
 IF MODMF=0 DO $( FLUSHLINE(); MODMF:=@NULL; RETURN $);
 MAKEMODAR(MFTWOU(MODMF)/2);
 IF MODARLIST=@NULL DO
  $(
  OUTS("(AROMATIZE COMMAND IGNORED)*C*L");
  FLUSHLINE();
  MODMF:=@NULL;
  RETURN
  $);

 IF FILEEXISTS(STIFILENAME(),CGEXT) THEN $(
  OUTS("(DESTROYING RECORDS OF STEREOCHEMISTRY!!!!!*C*L");
  WHILE DELETEFILE(STIFILENAME(),CGEXT) DO;
  $)

 OOUT:=OUTPUT;
 OUTPUT:=CREATEFILE("DSK",SC1FILENAME(),CGEXT);

 WRITERETTOME(THISPARTSTR)


 OUTNOL(LENGTH(CDR(MODMF)));
 PLIST(CDR(MODMF),AVOUT,""," "," ","*C*L0*C*L0*C*L");
 OUTNOL(LENGTH(MODARLIST));
 IF MODARLIST NE @NULL DO PLIST(MODARLIST,PRINARNNDS,""," "," ","*C*L");
 MAPC(MODARLIST,PASSARPATOUT);
 OUTS("0*C*L0*C*L");
 ENDWRITE(OUTPUT);
 OUTPUT:=OOUT;
 STARTCGPART1(DNDPPN,"IMBED");
 UNLIST(MODARLIST);
 MODARLIST:=@NULL;
 IF MODMF NE @NULL DO $( UNCONS(CAR(MODMF)); UNCONS(MODMF); MODMF:=@NULL $)
 $);

LET CGREFRESH() BE
 $( STATIC $( DEFNAME = NIL; U = NIL; ARSTRNUM = NIL $);

 LET FINDSEGP(CHUNKSEP,STR) BE
  IF FINDSEG(CHUNKSEP,STR)<0 DO 
   $( CLOSEIN(); OUTS("PLEASE RUN CGUPDATE ON THAT FILE*C*L"); EXIT(TRUE) $);

 OPENIN(TOPFILENAME);
 FINDSEGP(CHUNKSEP,MFHEADSTR);
 LINEIN("");
 MOLFORM:=LINELIST(INPR);
 FINDSEGP(CHUNKSEP,SSHEADSTR);
 LINEIN("");
 STRUCSTATUS:=LOPITEM();
 PARTIALFLAG:=(NEXTIS(STRTYPE) -> STREQUAL("PARTIAL",STROFNUM(LOPITEM())),
                                  FALSE);
 TEST STRUCSTATUS=0 THEN
  $(
  STRUCSTATUS:=LIST(0,0);
  MINSTRUCNO:=0;
  MAXSTRUCNO:=0
  $)
 OR
  $(
  LINEIN("");
  MINSTRUCNO:=LOPITEM();
  MAXSTRUCNO:=LOPITEM();
  LINEIN();
  U:=LOPITEM();
  STRUCSTATUS:=CONS(STRUCSTATUS,CONS(U,LINELIST(INPR)))
  $);
 FINDSEGP(CHUNKSEP,ARHEADSTR);
 LINEIN("");
 ARLIST:=@NULL;
 UNTIL NEXTIS(EOLTYPE) DO
  $(
  ARSTRNUM:=LOPITEM();
  ARLIST:=CONS(CONS(ARSTRNUM,STRSELECT(STROFNUM(ARSTRNUM),ARNAMETABLE)),ARLIST);
  LINEIN("")
  $);
 FINDSEGP(CHUNKSEP,TTHEADSTR);
 LINEIN("");
 TERMTYPE:=LOPITEM();
 FINDSEGP(CHUNKSEP,ESHEADSTR);
 SKIPSEG(ESSEP);
 ALLDEFS:=@NULL;
 $(
 LINEIN("");
 IF LITEMS!0=1 DO BREAK;
 DEFNAME:=LITEMS!2;
 LINEIN("");
 ALLDEFS:=CONS(CONS(DEFNAME,LINELIST(LOPITEM)),ALLDEFS);
 SKIPSEG(ESSEP);
 $) REPEAT;
 CLOSEIN();
 MODMF:=@NULL;
 SAPROPS:=@NULL;
 MODARLIST:=@NULL;
 INTERNALCONS:=@NULL;
 CONLENGTHS:=@NULL
 $);

GET "LIBFNS.BCL"
GET "FOSHDR.BCL"
MANIFEST $( NODECOUNTMAX = 800 $);
GET "XMNSRV.BCL"
GET "NMRTOP.BCL"
GET "MSSRV.BCL"
GET "NMRSRV.BCL"

